home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / jockguts.arc / NESTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  39KB  |  1,067 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  NestTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {Revision History:    2/13/89    5.00a corrected calculation of Y2 lines
  17.                                  542 and 544. (thanks Mike!)
  18. }
  19.  
  20.  
  21. {$S-,R-,V-,D-}       
  22.  
  23. Unit NestTTT5;
  24.  
  25. INTERFACE
  26.  
  27. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5;
  28.  
  29. CONST
  30.    Max_Levels = 10;        {maximum number of nested menus - alter if necessary}
  31.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  32.    DontClear    = 0;       {signal to return to same position in menu}
  33.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  34.    RefreshMenu  = 2;       {signal to reload current menu}
  35.    ClearCurrent = 3;       {signal to remove current menu}
  36.    ClearAll     = 4;       {signal to remove all menus}
  37.    Undefined    = 99;      {despatcher has not been assigned}
  38.  
  39. Type
  40.    {$IFDEF VER50}
  41.    Nest_Key_Proc =   procedure(var Ch:char; Code:Integer);
  42.    Despatcher_Proc = procedure(Var Code: integer; var Finish:byte);
  43.    {$ENDIF}
  44.  
  45.    MenuStr = string[MenuStrLength];
  46.  
  47.    N_Display = record
  48.                      X           : byte;     {top X coord}
  49.                      Y           : byte;     {top Y coord}
  50.                      LeftSide    : boolean;  {does menu start on left or right}
  51.                      AllowEsc    : boolean;  {can user escape from the top level}
  52.                      BoxType     : byte;     {single,double etc}
  53.                      BoxFCol     : byte;     {Border foreground color}
  54.                      BoxBCol     : byte;     {Border background color}
  55.                      CapFCol     : byte;     {Capital letter foreground color}
  56.                      BacCol      : byte;     {menu background color}
  57.                      NorFCol     : byte;     {normal foreground color}
  58.                      LoFCol      : byte;     {inactive topic foreground color}
  59.                      HiFCol      : byte;     {highlighted topic foreground color}
  60.                      HiBCol      : byte;     {highlighted topic background color}
  61.                      LeftChar    : char;     {left-hand topic highlight character}
  62.                      RightChar   : char;     {right-hand topic highlight character}
  63.                      {$IFDEF VER50}
  64.                      Hook        : Nest_Key_Proc;   { a procedure called after every key is pressed}
  65.                      Despatcher  : Despatcher_proc;     { the main procedure to execute}
  66.                      {$ENDIF}
  67.                end;
  68.  
  69.     TopicPtr    = ^TopicRecord;
  70.  
  71.     MenuPtr     = ^Nest_Menu;
  72.  
  73.     TopicRecord = record
  74.                         Name : MenuStr;
  75.                         Active: boolean;
  76.                         HotKey : char;
  77.                         RetCode : integer;
  78.                         Sub_Menu: MenuPtr;
  79.                         Next_Topic: TopicPtr;
  80.                    end;
  81.  
  82.     Nest_Menu  = record
  83.                         Title: MenuStr;          {title for menu}
  84.                         Topic_Width: byte;       {width of topics in menu}
  85.                         Visible_Lines : word;    {no. topics in box, 0 is DisplayLines - 2}
  86.                         First_Topic : TopicPtr;      {used internally, do not alter}
  87.                         Total_Topics: word;          {used internally, do not alter}
  88.                    end;
  89.  
  90.   VAR
  91.     {$IFNDEF VER50}
  92.     Nest_UserHook : pointer;
  93.     Nest_Despatcher: pointer;
  94.     {$ENDIF}
  95.     N_fatal : Boolean;
  96.     N_Error : Integer;
  97.     NTTT    : N_Display;
  98.  
  99.   Procedure Default_Settings;
  100.   {$IFDEF VER50}
  101.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  102.   {$ENDIF}
  103.  
  104.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  105.                                 Tit: menuStr;
  106.                                 Width: byte;
  107.                                 Display_Lines: word);
  108.  
  109.   Procedure Add_Topic(var Menu:Nest_Menu;
  110.                           Nam : MenuStr;
  111.                           Activ : boolean;
  112.                           HKey : char;
  113.                           Code : integer;
  114.                           Sub: MenuPtr);
  115.  
  116.   Procedure Modify_Topic(var Menu:Nest_Menu;
  117.                              TopicNo : word;
  118.                              Nam : MenuStr;
  119.                              Activ : boolean;
  120.                              HKey  : char;
  121.                              Code : integer;
  122.                              Sub: MenuPtr);
  123.  
  124.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  125.                                   TopicNo : word;
  126.                                   Nam : MenuStr);
  127.  
  128.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  129.                                   TopicNo : word;
  130.                                   Activ : Boolean);
  131.  
  132.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  133.                                     TopicNo : word;
  134.                                     HKey : char);
  135.  
  136.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  137.                                      TopicNo : word;
  138.                                      Code : integer);
  139.  
  140.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  141.                                      TopicNo : word;
  142.                                      Sub : MenuPtr);
  143.  
  144.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  145.  
  146.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  147.  
  148.   Procedure Show_Nest(var Menu:Nest_Menu);
  149.  
  150. IMPLEMENTATION
  151. var
  152.   Despatcher_Assigned : boolean;
  153.  
  154.   Procedure NestTTT_Error(No : byte);
  155.   {Updates N_error and optionally displays error message then halts program}
  156.   var Msg : String;
  157.   begin
  158.       N_error := No;
  159.       If N_fatal = true then
  160.       begin
  161.           Case No of
  162.           1 :  Msg := 'Insufficient memory to add topic';
  163.           2 :  Msg := 'Insufficient memory to save screen';
  164.           3 :  Msg := 'No active picks in menu';
  165.           4 :  Msg := 'Screen was not previously saved cannot restore';
  166.           5 :  Msg := 'Too many levels in menu. Change Max_Levels in NestTTT';
  167.           6 :  Msg := 'Topic does not exist, cannot modify';
  168.           7 :  Msg := 'A user procedure has not been assigned to despatcher';
  169.           else Msg := '?) -- Utterly confused';
  170.           end; {Case}
  171.           Msg := 'Fatal Error (NestTTT -- '+Msg;
  172.           Writeln(Msg);
  173.           Delay(5000);    {display long enough to read if child process}
  174.           Halt;
  175.       end;
  176.   end;
  177.  
  178. {$F+}
  179.   Procedure Empty_Despatcher(Var Code: integer; var Finish:byte);
  180.   {}
  181.   begin
  182.       Finish := Undefined;
  183.   end; {of proc Empty_Despatcher}
  184.  
  185.   Procedure No_Nest_Hook(var Ch : char; Code: Integer);
  186.   {}
  187.   begin
  188.   end; {of proc No_Nest_Hook}
  189. {$F-}
  190.  
  191.    {$IFNDEF VER50}
  192.    Procedure CallFromNestUserHook(var Ch:char; code:integer);
  193.           Inline($FF/$1E/Nest_UserHook);
  194.  
  195.    Procedure CallFromNestDespatcher(Var Code: integer; var Finish:byte);
  196.           Inline($FF/$1E/Nest_Despatcher);
  197.    {$ENDIF}
  198.  
  199.   Procedure Default_Settings;
  200.   begin
  201.       with NTTT do
  202.       begin
  203.           X := 0;
  204.           Y := 0;
  205.           Despatcher_Assigned := false;
  206.           LeftSide     := true;
  207.           AllowEsc := true;
  208.           BoxType      := 1;
  209.           If BaseOfScreen = $B800 then
  210.           begin
  211.               BoxFCol      := yellow;
  212.               BoxBCol      := blue;
  213.               CapFCol      := White;
  214.               BacCol       := blue;
  215.               NorFCol      := lightgray;
  216.               LoFCol       := black;
  217.               HiFCol       := white;
  218.               HiBCol       := red;
  219.           end
  220.           else
  221.           begin
  222.               BoxFCol      := white;
  223.               BoxBCol      := black;
  224.               CapFCol      := White;
  225.               BacCol       := black;
  226.               NorFCol      := lightgray;
  227.               LoFCol       := darkgray;
  228.               HiFCol       := white;
  229.               HiBCol       := black;
  230.           end;
  231.           LeftChar     := Chr(16);
  232.           RightChar    := Chr(17);
  233.           {$IFDEF VER50}
  234.           Hook := No_Nest_Hook;
  235.           Despatcher   := Empty_Despatcher;
  236.           {$ELSE}
  237.            Nest_UserHook := nil;
  238.            Nest_Despatcher:= nil;
  239.           {$ENDIF}
  240.       end;  {with}
  241.   end;  {Default_Settings}
  242.  
  243.   {$IFDEF VER50}
  244.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  245.   begin
  246.       NTTT.Despatcher := D;
  247.       Despatcher_Assigned := true;
  248.   end;
  249.   {$ENDIF}
  250.  
  251.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  252.                                 Tit: menuStr;
  253.                                 Width: byte;
  254.                                 Display_Lines: word);
  255.   {}
  256.   begin
  257.       With Menu do
  258.       begin
  259.           Title         := Tit;
  260.           Topic_Width   := Width;
  261.           Visible_Lines := Display_Lines;
  262.           First_Topic   := nil;
  263.           Total_Topics  := 0;
  264.       end; {with}
  265.   end; {of proc Initialize_Menu}
  266.  
  267.   Procedure Add_Topic(var Menu:Nest_Menu;
  268.                           Nam : MenuStr;
  269.                           Activ : boolean;
  270.                           HKey  : char;
  271.                           Code : integer;
  272.                           Sub: MenuPtr);
  273.   {Adds a new topic to the menu.}
  274.   var
  275.      TempPtr : TopicPtr;
  276.   begin
  277.       If MaxAvail < SizeOf(TempPtr^) then
  278.       begin
  279.           NestTTT_Error(1);   {not enough memory}
  280.           exit;
  281.       end
  282.       else
  283.          N_Error := 0;
  284.       If Menu.First_Topic = nil then
  285.       begin
  286.          getmem(Menu.First_Topic,SizeOf(TempPtr^));
  287.          TempPtr := Menu.First_Topic;
  288.       end
  289.       else
  290.       begin
  291.          TempPtr := Menu.First_Topic;          {start at bottom}
  292.          while TempPtr^.Next_Topic <> nil do               {loop to unallocated block}
  293.             TempPtr := TempPtr^.Next_Topic;
  294.          GetMem(TempPtr^.Next_Topic,SizeOf(TempPtr^));
  295.          TempPtr := TempPtr^.Next_Topic;
  296.       end;
  297.       with TempPtr^ do
  298.       begin
  299.           Name := Nam;
  300.           If (Name = '-') or (Name = '=') then
  301.              Active := false
  302.           else
  303.              Active := Activ;
  304.           HotKey := Hkey;
  305.           RetCode := Code;
  306.           Sub_Menu := Sub;
  307.           Next_Topic := nil;
  308.       end;
  309.       Inc(Menu.Total_Topics);
  310.   end; {of proc Add_Topic}
  311.  
  312.   Function Pointer_to_Topic(Men:Nest_Menu;TopicNo:word): TopicPtr;
  313.   {returns a pointer to the TopicNo'th entry in menu, or nil
  314.    if greater than Total_Topics}    
  315.   var    
  316.      W       : word;    
  317.      TempPtr : TopicPtr;    
  318.   begin    
  319.       with Men do
  320.       begin    
  321.           If TopicNo > Total_Topics then
  322.              TempPtr := nil
  323.           else    
  324.           begin
  325.               TempPtr := First_Topic;    
  326.               For W := 2 to TopicNo do    
  327.                       TempPtr := TempPtr^.Next_Topic    
  328.           end;    
  329.       end;    
  330.       Pointer_to_Topic := TempPtr;    
  331.   end; {of func Pointer_to_Topic}
  332.  
  333.   Procedure Modify_Topic(var Menu:Nest_Menu;
  334.                              TopicNo : word;
  335.                              Nam : MenuStr;
  336.                              Activ : boolean;
  337.                              HKey  : char;
  338.                              Code : integer;
  339.                              Sub: MenuPtr);
  340.   {Changes all the settings for a topic}
  341.   var TempPtr : TopicPtr;
  342.   begin
  343.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  344.       If TempPtr = nil then 
  345.          NestTTT_Error(6);
  346.       With TempPtr^ do
  347.       begin
  348.           Name := Nam;
  349.           If (Name = '-') or (Name = '=') then
  350.              Active := false
  351.           else
  352.              Active := Activ;
  353.           HotKey := Hkey;
  354.           RetCode := Code;
  355.           Sub_Menu := Sub;
  356.       end; {with}
  357.   end; {of proc Modify_Topic}
  358.  
  359.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  360.                                   TopicNo : word;
  361.                                   Nam : MenuStr);
  362.   {Change title or name of a topic}
  363.   var TempPtr : TopicPtr;
  364.   begin
  365.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  366.       If TempPtr = nil then 
  367.          NestTTT_Error(6);
  368.       TempPtr^.Name := Nam;
  369.       If (Nam = '-') or (Nam = '=') then
  370.              TempPtr^.Active := false;
  371.   end; {of proc Modify_Topic_Name}
  372.  
  373.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  374.                                   TopicNo : word;
  375.                                   Activ : Boolean);
  376.   {Changes active status of a topic}
  377.   var TempPtr : TopicPtr;
  378.   begin
  379.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  380.       If TempPtr = nil then 
  381.          NestTTT_Error(6);
  382.       TempPtr^.Active := Activ;
  383.   end; {of proc Modify_Topic_Active}
  384.  
  385.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  386.                                     TopicNo : word;
  387.                                     HKey : char);
  388.   {Changes Hotkey character of a topic}
  389.   var TempPtr : TopicPtr;
  390.   begin
  391.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  392.       If TempPtr = nil then
  393.          NestTTT_Error(6);
  394.       TempPtr^.HotKey := HKey;
  395.   end; {of proc Modify_Topic_HotKey}
  396.  
  397.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  398.                                      TopicNo : word;
  399.                                      Code : integer);
  400.   {Changes Return code for a topic}
  401.   var TempPtr : TopicPtr;
  402.   begin
  403.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  404.       If TempPtr = nil then 
  405.          NestTTT_Error(6);
  406.       TempPtr^.Retcode := Code;
  407.   end; {of proc Modify_Topic_HotKey}
  408.  
  409.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  410.                                      TopicNo : word;
  411.                                      Sub : MenuPtr);
  412.   {Changes Return code for a topic}
  413.   var TempPtr : TopicPtr;
  414.   begin
  415.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  416.       If TempPtr = nil then
  417.          NestTTT_Error(6);
  418.       TempPtr^.Sub_Menu := Sub;
  419.   end; {of proc Modify_Topic_HotKey}
  420.  
  421.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  422.   {}
  423.   var TempPtrA,TempPtrB : TopicPtr;
  424.   begin
  425.       If TopicNo = 1 then
  426.       begin
  427.           If Menu.First_Topic = nil then
  428.              NestTTT_Error(6);
  429.           TempPtrA := Menu.First_Topic^.Next_Topic;
  430.           FreeMem(Menu.First_Topic,SizeOf(TempPtrA^));
  431.           Menu.First_Topic := TempPtrA;
  432.       end
  433.       else
  434.       begin
  435.           TempPtrA := Pointer_To_Topic(Menu,pred(TopicNo));
  436.           If TempPtrA = nil then
  437.              NestTTT_Error(6);
  438.           TempPtrB := Pointer_To_Topic(Menu,TopicNo);
  439.           If TempPtrB = nil then
  440.              NestTTT_Error(6);
  441.           TempPtrA^.Next_Topic := TempPtrB^.Next_Topic;
  442.           FreeMem(TempPtrB,SizeOf(TempPtrB^));
  443.       end;
  444.       Dec(Menu.Total_Topics);
  445.   end; {of proc Delete_A_Topic}
  446.  
  447.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  448.   {}
  449.   var TempPtrA,TempPtrB : TopicPtr;
  450.   begin
  451.       TempPtrA := Menu.First_Topic;
  452.       While (TempPtrA <> nil) do
  453.       begin
  454.           TempPtrB := TempPtrA^.Next_Topic;
  455.           If TempPtrA <> nil then
  456.           begin
  457.               FreeMem(TempPtrA,SizeOf(TempPtrA^));
  458.               TempPtrA := TempPtrB;
  459.           end;
  460.       end;
  461.       Menu.First_Topic := nil;
  462.   end; {of proc Delete_All_Topics}
  463.  
  464.   Procedure Show_Nest(var Menu:Nest_Menu);
  465.   Type
  466.      LevelInfo = record
  467.                       Pick : word;
  468.                       TheMenu : MenuPtr;     {link to menu}
  469.                       X1   : integer;           {coords of saved screens}
  470.                       Y1   : integer;
  471.                       X2   : integer;
  472.                       Y2   : integer;
  473.                       TopPick : byte;
  474.                       HiPick  : byte;
  475.                       Saved_Screen: Pointer; {location of saved screen}
  476.                  end;
  477.   Var
  478.      I : word;
  479.      TempPtr : TopicPtr;
  480.      FinCode : byte;
  481.      Nest : array[1..Max_Levels] of LevelInfo;
  482.      Current_Level : byte;
  483.      LiveMenu : Nest_menu;
  484.      ChL : char;
  485.      Found,
  486.      Finished : boolean;
  487.  
  488.       Function Topic_Pointer(TopicNo:word): TopicPtr;
  489.       begin
  490.           Topic_Pointer := Pointer_to_Topic(LiveMenu,TopicNo);
  491.       end; {of func Topic_Pointer}
  492.  
  493.  
  494.       Procedure Compute_Coords(var LiveMenu:Nest_Menu);
  495.       {determines X1,Y1,X2,Y2 for new menu}
  496.       begin
  497.           With Nest[Current_level] do
  498.           begin
  499.               If LiveMenu.Visible_Lines = 0 then
  500.                  LiveMenu.Visible_Lines := DisplayLines-2;
  501.               If LiveMenu.Total_Topics < LiveMenu.Visible_Lines then
  502.                  LiveMenu.Visible_Lines := LiveMenu.Total_Topics;
  503.               If Current_Level = 1 then
  504.               begin
  505.                   If NTTT.X = 0 then
  506.                   begin
  507.                       If NTTT.LeftSide then
  508.                       begin
  509.                           X1 := 1;
  510.                           X2 := LiveMenu.Topic_Width + 4;
  511.                       end
  512.                       else    {RightSide}
  513.                       begin
  514.                           X2 := 80;
  515.                           X1 := 80 - LiveMenu.Topic_Width - 3;
  516.                       end;
  517.                   end
  518.                   else {X not Zero}
  519.                   begin
  520.                       If NTTT.LeftSide then
  521.                       begin
  522.                           X1 := NTTT.X;
  523.                           X2 := pred(X1)+LiveMenu.Topic_Width + 4;
  524.                           If X2 > 80 then
  525.                           begin
  526.                               X2 := 80;
  527.                               X1 := X2 - 3 - LiveMenu.Topic_Width;
  528.                           end;
  529.                       end
  530.                       else    {RightSide}
  531.                       begin
  532.                           X2 := NTTT.X;
  533.                           X1 := X2 - LiveMenu.Topic_Width - 3;
  534.                           If X1 < 1 then
  535.                           begin
  536.                               X1 := 1;
  537.                               X2 := X1 +LiveMenu.Topic_Width +3;
  538.                           end;
  539.                       end;
  540.                   end;
  541.                   If NTTT.Y = 0 then
  542.                      Y1 := 1
  543.                   else
  544.                      Y1 := NTTT.Y;
  545.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  546. {mod 5.00a}          Y2 := Y1 + succ(LiveMenu.Visible_Lines)
  547.                   else
  548.                      Y2 := Y1 + succ(LiveMenu.Total_Topics);
  549.                   If Y2 > DisplayLines then
  550.                   begin
  551.                      Y2 := DisplayLines;
  552.                      LiveMenu.Visible_Lines := Y2 - succ(Y1);
  553.                   end;
  554.               end
  555.               else   {not the first level menu}
  556.               begin
  557.                   If NTTT.LeftSide then
  558.                   begin
  559.                       X1 := pred(Nest[pred(Current_Level)].X2);
  560.                       X2 := X1 + 3 + LiveMenu.Topic_Width;
  561.                       If X2 > 80 then
  562.                       begin
  563.                           X2 := 80;
  564.                           X1 := X2 - 4 - LiveMenu.Topic_Width;
  565.                       end;
  566.                   end
  567.                   else   {rightside}
  568.                   begin
  569.                       X2 := succ(Nest[pred(Current_Level)].X1);
  570.                       X1 := X2 - LiveMenu.Topic_Width - 3;
  571.                       If X1 < 1 then
  572.                       begin
  573.                           X1 := 1;
  574.                           X2 := X1 +LiveMenu.Topic_Width +3;
  575.                       end;
  576.                   end;
  577.                   Y1 := succ(Nest[Pred(Current_Level)].Y1) +
  578.                         Nest[Pred(Current_Level)].HiPick -
  579.                         Nest[Pred(Current_Level)].TopPick;
  580.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  581.                      Y2 := succ(Y1) + LiveMenu.Visible_Lines
  582.                   else
  583.                      Y2 := succ(Y1) + LiveMenu.Total_Topics;
  584.                   If Y2 > DisplayLines then
  585.                   begin
  586.                      Y2 := DisplayLines;
  587.                      If Y2 - succ(LiveMenu.Visible_Lines) >= 1 then
  588.                         Y1 := Y2 - succ(LiveMenu.Visible_Lines)
  589.                      else
  590.                      begin
  591.                          Y1 := 1;
  592.                          LiveMenu.Visible_Lines := DisplayLines - 2;
  593.                      end;
  594.                   end;
  595.               end;
  596.           end; {With}
  597.       end; {of proc Compute_Coords}
  598.  
  599.       Procedure Save_Screen;
  600.       {saved part of screen overlayed by menu}
  601.       begin
  602.           with Nest[Current_Level] do
  603.           begin
  604.               If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  605.                   NestTTT_Error(2)
  606.               else
  607.               begin
  608.                   GetMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  609.                   PartSave(X1,Y1,X2,Y2,Saved_Screen^);
  610.               end;
  611.           end;
  612.       end; {of proc Save_Screen}
  613.  
  614.       Procedure Restore_Screen;
  615.       {saved part of screen overlayed by menu}
  616.       begin
  617.           with Nest[Current_Level] do
  618.           begin
  619.               If Saved_Screen = nil then
  620.                   NestTTT_Error(4)
  621.               else
  622.               begin
  623.                   PartRestore(X1,Y1,X2,Y2,Saved_Screen^);
  624.                   FreeMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  625.               end;
  626.           end;
  627.       end; {of proc Restore_Screen}
  628.  
  629.       Procedure Compute_First_Active_Pick;
  630.       {}
  631.       var I : word;
  632.       begin
  633.           With Nest[Current_level] do
  634.           begin
  635.               TopPick := 1;
  636.               HiPick := 1;
  637.               While (Topic_Pointer(HiPick)^.Active = false)
  638.               and   (HiPick < LiveMenu.Total_Topics) do
  639.                     Inc(HiPick);
  640.               If (Topic_Pointer(HiPick)^.Active = false) then {no active picks in menu}
  641.               begin
  642.                   NestTTT_Error(3);
  643.                   exit;
  644.               end;
  645.               If HiPick > LiveMenu.Visible_Lines then
  646.                  TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  647.           end; {with}
  648.       end; {of proc Compute_First_Active_Pick}
  649.  
  650.       Procedure Compute_Topic_Width(var Livemenu:Nest_Menu);
  651.       {}
  652.       var
  653.         I : word;
  654.         W,Biggest : Byte;
  655.       begin
  656.           Biggest := 0;
  657.           For I := 1 To LiveMenu.Total_Topics do
  658.           begin
  659.               W := length(Topic_Pointer(I)^.Name);
  660.               If Biggest < W then
  661.                  Biggest := W;
  662.           end;
  663.           If Biggest < length(LiveMenu.Title) then
  664.              Biggest := length(LiveMenu.Title);
  665.           LiveMenu.Topic_Width := Biggest;
  666.       end; {of proc Compute_Topic_Width}
  667.  
  668.       Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  669.       {}
  670.       var
  671.         A,Y : byte;
  672.         T : TopicPtr;
  673.       begin
  674.          T := Topic_Pointer(TopicNo);
  675.          If T = Nil then
  676.             exit;
  677.          If HiLight then
  678.             A := attr(NTTT.HiFCol,NTTT.HiBCol)
  679.          else
  680.          begin
  681.              If T^.Active then
  682.                 A := attr(NTTT.NorFcol,NTTT.BacCol)
  683.              else
  684.                 A := attr(NTTT.LoFcol,NTTT.BacCol);
  685.          end;
  686.          with Nest[Current_level] do
  687.          begin
  688.              Y := succ(Y1) + TopicNo - TopPick;
  689.              If HiLight then
  690.                 Fastwrite(succ(X1),Y,A,
  691.                           NTTT.LeftChar+
  692.                           PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  693.                           NTTT.Rightchar)
  694.              else
  695.                 Case T^.Name[1] of
  696.                 '-': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  697.                 '=': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  698.                 else
  699.                     begin
  700.                         Fastwrite(succ(X1),Y,A,
  701.                                   ' '+
  702.                                   PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  703.                                   ' ');
  704.                         If (T^.Active) and (First_Capital_Pos(T^.Name) > 0) then
  705.                            Fastwrite(succ(X1)+First_Capital_Pos(T^.Name),
  706.                                      Y,
  707.                                      attr(NTTT.CapFCol,NTTT.BacCol),
  708.                                      First_Capital(T^.Name));
  709.                     end;
  710.                 end; {Case}
  711.          end;
  712.       end; {of proc Write_Topic}
  713.  
  714.       Procedure Display_All_Topics;
  715.       {}
  716.       var I : Integer;
  717.       begin
  718.           with Nest[Current_Level] do
  719.           begin
  720.               For I := TopPick to TopPick+pred(LiveMenu.Visible_Lines) do
  721.                   Write_Topic(I,false);
  722.               Write_Topic(HiPick,true);
  723.           end;
  724.       end; {of proc Display_All_Topics}
  725.  
  726.       Procedure Display_LiveMenu;
  727.       {}
  728.       begin
  729.           with Nest[Current_Level] do
  730.           begin
  731.               FBox(X1,Y1,X2,Y2,NTTT.BoxFCol,NTTT.BoxBCol,NTTT.BoxType);
  732.               WriteBetween(X1,X2,Y1,NTTT.BoxFCol,NTTT.BoxBCol,Livemenu.Title);
  733.           end;
  734.           Display_All_Topics;
  735.       end; {of proc Display_LiveMenu}
  736.  
  737.       Function Next_Pick_Down(Wrap:boolean): word;
  738.       {}
  739.       var P : word;
  740.       begin
  741.           with Nest[Current_Level] do
  742.           begin
  743.               P := HiPick;
  744.               If P < LiveMenu.Total_Topics then
  745.               begin
  746.                   inc(P);
  747.                   while (P < LiveMenu.Total_Topics)
  748.                   and   (Topic_Pointer(P)^.Active = false) do
  749.                         Inc(P);
  750.                   If Topic_Pointer(P)^.Active = false then
  751.                   begin
  752.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  753.                       begin
  754.                          P := TopPick;  {scroll to top}
  755.                          while (P < LiveMenu.Total_Topics)
  756.                          and   (Topic_Pointer(P)^.Active = false) do
  757.                                Inc(P);
  758.                       end
  759.                       else
  760.                          P := Hipick;
  761.                   end;
  762.               end
  763.               else     {P is at bottom of menu}
  764.               begin
  765.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  766.                      P := TopPick;  {scroll to top}
  767.                   while (P < LiveMenu.Total_Topics)
  768.                   and   (Topic_Pointer(P)^.Active = false) do
  769.                         Inc(P);
  770.               end;
  771.               Next_Pick_Down := P;
  772.           end; {with}
  773.       end; {of func Next_Pick_Down}
  774.  
  775.       Function Next_Pick_Up(Wrap:boolean): word;
  776.       {}
  777.       var P : word;
  778.       begin
  779.           with Nest[Current_Level] do
  780.           begin
  781.               P := HiPick;
  782.               If P > 1 then
  783.               begin
  784.                   dec(P);
  785.                   while (P > 1)
  786.                   and   (Topic_Pointer(P)^.Active = false) do
  787.                         Dec(P);
  788.                   If Topic_Pointer(P)^.Active = false then
  789.                   begin
  790.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  791.                       begin
  792.                          P := LiveMenu.Total_Topics;  {scroll to top}
  793.                          while (P > 1)
  794.                          and   (Topic_Pointer(P)^.Active = false) do
  795.                                Dec(P);
  796.                       end
  797.                       else
  798.                          P := Hipick;
  799.                   end;
  800.               end
  801.               else     {P is at top of menu}
  802.               begin
  803.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  804.                   begin
  805.                      P := LiveMenu.Total_Topics;  {scroll to top}
  806.                      while (P > 1)
  807.                      and   (Topic_Pointer(P)^.Active = false) do
  808.                            Dec(P);
  809.                   end;
  810.               end;
  811.               Next_Pick_Up := P;
  812.           end; {with}
  813.       end; {of func Next_Pick_Up}
  814.  
  815.       Procedure Load_Menu(var NewMenu:Nest_Menu);
  816.       {}
  817.       begin
  818.           If Current_Level < Max_Levels then
  819.              Inc(Current_Level)
  820.           else
  821.              NestTTT_Error(5);
  822.           Nest[Current_Level].TheMenu := @NewMenu;
  823.           LiveMenu := NewMenu;
  824.           If LiveMenu.Topic_Width <= 0 then
  825.           begin
  826.              Compute_Topic_Width(LiveMenu);
  827.              NewMenu.Topic_Width := LiveMenu.Topic_Width;
  828.           end;
  829.           Compute_Coords(LiveMenu);
  830.           Compute_Coords(NewMenu);
  831.           Compute_First_Active_Pick;
  832.           Save_Screen;
  833.           Display_LiveMenu;
  834.       end; {of proc Load_Menu;}
  835.  
  836.       Procedure Execute_Command;
  837.       {}
  838.       var
  839.          TempPtr : TopicPtr;
  840.          Code : integer;
  841.       begin
  842.           TempPtr := Topic_Pointer(Nest[Current_Level].HiPick);
  843.           If TempPtr^.Sub_Menu <> nil then
  844.              Load_Menu(TempPtr^.Sub_Menu^)
  845.           else
  846.           begin
  847.               Code := TempPtr^.Retcode;
  848.               {$IFDEF VER50}
  849.               NTTT.Despatcher(Code,Fincode);
  850.               {$ELSE}
  851.               If Nest_Despatcher <> Nil then
  852.                  CallFromNestDespatcher(Code,Fincode)
  853.               else
  854.                  Fincode := Undefined;
  855.               {$ENDIF}
  856.               Case Fincode of
  857.               Undefined    :NestTTT_Error(7);
  858.               DontClear    :;
  859.               RefreshTopic : Write_Topic(Nest[Current_Level].HiPick,True);
  860.               RefreshMenu  : Display_All_Topics;
  861.               ClearCurrent : begin
  862.                                  Restore_Screen;
  863.                                  If Current_Level > 1 then
  864.                                  begin
  865.                                     Dec(Current_Level);
  866.                                     LiveMenu := Nest[Current_Level].TheMenu^;
  867.                                  end
  868.                                  else
  869.                                     Finished := true;
  870.                              end;
  871.               ClearAll     : begin
  872.                                  While Current_Level > 0 do
  873.                                  begin
  874.                                      Restore_Screen;
  875.                                      Dec(Current_Level);
  876.                                      LiveMenu := Nest[Current_Level].TheMenu^;
  877.                                  end;
  878.                                  Finished := true;
  879.                              end;
  880.               end; {Case}
  881.           end;
  882.       end; {of proc Execute_Command}
  883.  
  884.      Procedure Display_More;
  885.      {}
  886.      var A : byte;
  887.      begin
  888.          If LiveMenu.Visible_Lines < Livemenu.Total_Topics then
  889.             with  Nest[Current_Level] do
  890.             begin
  891.                 A := attr(NTTT.CapFCol,NTTT.BoxBCol);
  892.                 If TopPick > 1 then
  893.                    Fastwrite(X2,Succ(Y1),A,chr(24))
  894.                 else
  895.                    VertLine(X2,Succ(Y1),Succ(Y1),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  896.                 If TopPick + Pred(LiveMenu.Visible_Lines) < LiveMenu.Total_Topics then
  897.                    Fastwrite(X2,Pred(Y2),A,chr(25))
  898.                 else
  899.                    VertLine(X2,Pred(Y2),Pred(Y2),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  900.             end;
  901.      end; {of proc Display_More}
  902.  
  903.   begin
  904.       Current_level := 0;
  905.       {$IFDEF VER50}
  906.       If not Despatcher_Assigned then
  907.          NestTTT_Error(7);
  908.       {$ELSE}
  909.       If Nest_Despatcher = nil then
  910.          NestTTT_Error(7);
  911.       {$ENDIF}
  912.       Load_Menu(Menu);
  913.       Finished := False;
  914.       Repeat
  915.            Display_More;
  916.            ChL := GetKey;
  917.            {$IFDEF VER50}
  918.            NTTT.Hook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  919.            {$ELSE}
  920.            If Nest_UserHook <> Nil then
  921.               CallFromNestUserHook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  922.            {$ENDIF}
  923.            If ChL <> #0 then
  924.            Case upcase(ChL) of
  925.            #132,                               {right button}
  926.            #027    : If Current_Level = 1 then
  927.                      begin
  928.                          If NTTT.AllowEsc then
  929.                          begin
  930.                              Restore_Screen;
  931.                              Finished := true;
  932.                          end;
  933.                      end
  934.                      else
  935.                      begin
  936.                          Restore_Screen;
  937.                          Dec(Current_Level);
  938.                          LiveMenu := Nest[Current_Level].TheMenu^;
  939.                      end;
  940.            #133,                                       {Mouse left button}
  941.            #13     : begin                             {Enter}
  942.                          Execute_Command;
  943.                      end;
  944.            ' ',
  945.            #129,                                       {Mouse down}
  946.            #208    : with Nest[Current_Level] do       {Down arrow}
  947.                      begin
  948.                          Write_Topic(HiPick,False);
  949.                          HiPick := Next_Pick_Down(ChL = #208);
  950.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  951.                          begin
  952.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  953.                              Display_All_Topics;
  954.                          end;
  955.                          Write_Topic(HiPick,True);
  956.                      end;
  957.            #128,                                       {Mouse up}
  958.            #200    : with Nest[Current_Level] do       {Up arrow}
  959.                      begin
  960.                          Write_Topic(HiPick,False);
  961.                          HiPick := Next_Pick_Up(ChL = #200);
  962.                          If HiPick < TopPick  then
  963.                          begin
  964.                              TopPick := HiPick;
  965.                              Display_All_Topics;
  966.                          end;
  967.                          Write_Topic(HiPick,True);
  968.                      end;
  969.             #199   : If Nest[Current_Level].HiPick <> 1 then      {Home}
  970.                      begin
  971.                          Compute_First_Active_Pick;
  972.                          Display_All_Topics;
  973.                      end;
  974.             #207   : With Nest[Current_Level] do
  975.                      begin
  976.                          Write_Topic(HiPick,False);
  977.                          HiPick := LiveMenu.Total_Topics;
  978.                          While (HiPick > 0)
  979.                          and (Topic_Pointer(HiPick)^.Active =false) do
  980.                               Dec(HiPick);
  981.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  982.                          begin
  983.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  984.                              Display_All_Topics;
  985.                          end;
  986.                          Write_Topic(HiPick,True);
  987.                      end;
  988.            'A'..'Z': with Nest[Current_Level] do
  989.                      begin
  990.                          Found := false;
  991.                          I := HiPick;
  992.                          Repeat      
  993.                               TempPtr := Topic_Pointer(I);
  994.                               If  (First_Capital(TempPtr^.Name) = upcase(ChL))
  995.                               and (TempPtr^.Active) then      
  996.                               begin      
  997.                                   Found := true;
  998.                                   Write_Topic(HiPick,false);      
  999.                                   HiPick := I;
  1000.                                   If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1001.                                   begin
  1002.                                       TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1003.                                       Display_All_Topics;
  1004.                                   end
  1005.                                   else
  1006.                                      If HiPick < TopPick  then
  1007.                                      begin
  1008.                                          TopPick := HiPick;
  1009.                                          Display_All_Topics;
  1010.                                      end;
  1011.                                      Write_Topic(HiPick,true);
  1012.                               end      
  1013.                               else      
  1014.                                   If I = LiveMenu.Total_Topics then
  1015.                                      I := 1
  1016.                                   else
  1017.                                      Inc(I);
  1018.                          Until Found or (I = HiPick);
  1019.                          If Found then
  1020.                             Execute_Command;
  1021.                      end;
  1022.            else   {see if the user pressed a special key}
  1023.                with Nest[Current_Level] do
  1024.                begin
  1025.                Found := false;
  1026.                I := HiPick;
  1027.                Repeat
  1028.                     TempPtr := Topic_Pointer(I);
  1029.                     If  ((TempPtr^.Hotkey) = ChL)
  1030.                     and (TempPtr^.Active) then
  1031.                     begin
  1032.                         Found := true;
  1033.                         Write_Topic(HiPick,false);
  1034.                         HiPick := I;
  1035.                         If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1036.                         begin
  1037.                             TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1038.                             Display_All_Topics;
  1039.                         end
  1040.                         else
  1041.                            If HiPick < TopPick  then
  1042.                            begin
  1043.                                TopPick := HiPick;
  1044.                                Display_All_Topics;
  1045.                            end;
  1046.                            Write_Topic(HiPick,true);
  1047.                     end
  1048.                     else
  1049.                         If I = LiveMenu.Total_Topics then
  1050.                            I := 1
  1051.                         else
  1052.                            Inc(I);
  1053.                Until Found or (I = HiPick);
  1054.                If Found then
  1055.                   Execute_Command;
  1056.                end;
  1057.       end; {case}
  1058.       Until Finished;
  1059.   end; {of proc Show_Nest}
  1060.  
  1061.  
  1062. begin
  1063.     Default_Settings;
  1064.     N_Fatal := true;
  1065. end.
  1066.  
  1067.